기생충의 아카데미상 수상에 따라 위상이 높아진 한국영화의 흥행요인과 관객 수에 영향을 미치는 항목을 알아보고, 회귀모형을 통해 최근 상영이 종료된 영화의 관객수를 예측 및 비교해봄.
| 구분 | 칼럼명 | 칼럼내용 | 변수타입 | 추가설명 |
|---|---|---|---|---|
| movieCd | 영화코드 | chr | 다른 데이터와 붙이기 위한 key 값 | |
| movieNm | 영화 이름 | chr | ||
| openDt | 개봉일 | POSIXct | ||
| 입력변수 | nations | 국가 | Factor | Levels : 미국 제3국 한국 |
| 입력변수 | scrnCnt | 상영횟수 | num | |
| 목표변수 | audiCnt | 관객수 | num | |
| 입력변수 | watchGrade | 영화등급 | Factor | Levels : 12세이상관람가 15세관람가 15세이상관람가 전체관람가 청소년관람불가 |
| 입력변수 | showTm | 상영시간 | int | |
| 입력변수 | genre | 장르 | Factor | Levels : SF 공포(호러) 드라마 뮤지컬 미스터리 범죄 사극 스릴러 애니메이션 액션 어드벤처 전쟁 코미디 판타지 |
| company | 배급사 | chr | ||
| direct | 감독 | chr | ||
| 파생변수 | actor1 | 배우1 | chr | |
| 파생변수 | actor2 | 배우2 | chr | actors 배우가 한명만 존재시 NA값으로 생성 |
| 파생변수 | actor3 | 배우3 | chr | actors 배우가 한명 혹은 두명만 존재시 NA값으로 생성 |
| 파생변수 | actor1_audiCnt_mean | 배우1 평균 관객수 | num | |
| 파생변수 | actor2_audiCnt_mean | 배우2 평균 관객수 | num | |
| 파생변수 | actor3_audiCnt_mean | 배우3 평균 관객수 | num | |
| 파생변수 | month | 월 | chr | 계절을 구분하기 위해 생성 |
| 파생변수 | week | 요일 | Factor | Levels : Fri Mon Sat Sun Thu Tue Wed |
| 파생변수 | season | 계절 | Factor | Levels : 가을 겨울 봄 여름 |
| 입력 / 파생변수 | cmopany_score | 배급사 평균 관객수 | num | |
| 입력 / 파생변수 | season_score | 계절 평균 관객수 | num | |
| 입력 / 파생변수 | week_score | 요일 평균 관객수 | num | |
| 입력 / 파생변수 | actor_score | 배우1 배우2 배우3 총 합 평균 관객수 | num | 배우1 가중치 : 0.5배우2 가중치 : 0.3배우3 가중치 : 0.2 |
| 입력 / 파생변수 | direct_score | 감독 평균 관객수 | num |
# 관람등급 확인 시 청소년관람 불가 비율이 많음.
# 개봉영화 건수와는 다르게 12세이상 관람가의 영화가 가장 관객수가 많음
# 한국/미국/일본 3개국의 다수의 영화가 개봉됨
# 한국.미국영화의 관객수가 압도적으로 많고, 일본과 기타 국가의 경우 개봉편수에 비해 관객수가 매우 적음을 알 수 있음
# 개봉영화는 드라마 > 멜로/로맨스 > 액션 순으로 나타남
# 관객 수는 액션 > 드라마 > 애니메이션 순서
# 1시간 이상 ~ 2시간 미만 상영시간이 압도적으로 높다.
# 하지만 관객들은 2시간이상 3시간 미만 영화를 더 관람하였다.
## # A tibble: 6 x 2
## 영화명 상영시간
## <chr> <dbl>
## 1 오페라-장미의 기사 285
## 2 오페라-아르미다 (메트로폴리탄) 244
## 3 파르지팔 270
## 4 윌리엄 텔 257
## 5 돈 카를로 249
## 6 반지의 제왕 : 왕의 귀환 (확장판) 263
# 상영시간 4시간 이상 영화 리스트
# 3D Bar Plot로 확인해 본 결과, 주연배우 중에서도 메인급인 배우가 다작을 했음을 알 수 있음
## # A tibble: 14 x 2
## 배우 `10년간 작품수`
## <chr> <int>
## 1 맷 데이먼 15
## 2 마동석 14
## 3 엄상현 13
## 4 드웨인 존슨 12
## 5 리암 니슨 12
## 6 황정민 12
## 7 설경구 11
## 8 조니 뎁 11
## 9 마이클 패스벤더 9
## 10 성룡 9
## 11 니콜라스 케이지 8
## 12 에단 호크 8
## 13 견자단 6
## 14 브루스 윌리스 4
# 10년간 작품수 확인결과 국내 유명배우 중에서는 마동석이 가장 많이 찍음
# 감독과 배우별로 네트워크맵을 그려봄
library(randomForest)
library(gbm)
<데이터 분할>
# 80%를 훈련용, 20%를 시험용 데이터로 분리
<1. Random Forest>
grid <- expand.grid(ntree = c(300, 500, 700, 1000),
mtry = c(3, 4, 5, 6, 7),
mse = NA)
## ntree mtry mse
## 12 1000 5 564718480550
# 나무의 수와 입력변수의 수를 총 20가지 조합으로 생성하여 에러가 최소인 모형을 찾아봄
# MSE가 최소인 나무수 1,000개 / 입력변수의 수 5개가 베스트 파라미터로 확인됨
## %IncMSE IncNodePurity
## nations 7.047095 15732797310126
## scrnCnt 35.936007 871011772027924
## watchGrade 3.895950 43527468791189
## showTm 5.855517 129483030542111
## genre 2.214558 189394418145071
## company_score 11.910634 137635631284968
## season_score 0.864144 35916170346832
## week_score 4.626522 20798531342190
## actor_score 62.551722 2870075043538558
## direct_score 46.721333 1622501597389618
# 변수의 중요도가 배우 > 감독 > 스크린수 > 배급사 순으로 나타남
## RF_RMSE RF_MAPE
## 1 526987 1.01
# 시험셋으로 목표변수의 추정값을 확인해보고 RMSE, MAPE를 구해봄. MAPE가 1.02으로 랜덤포레스트 회귀모형이 실제값을 예측할 수 있음
<2. Gradient Boosting Machine>
grid <- expand.grid(depth = c(1, 3, 5),
learn = c(0.01, 0.05, 0.10),
min = c(5, 7, 10),
bag = c(0.5, 0.8, 1.0),
rmse = NA,
tree = NA)
## [1] 78
## depth learn min bag rmse tree
## 78 5 0.05 10 1 729124 100
# 나무의 깊이, 학습률, 최소관측값, 샘플링 비중을 총 81가지 조합으로 생성하여 에러가 최소인 모형을 찾아봄
# RMSE가 최소인 베스트 파라미터로 확인
## var rel.inf
## actor_score actor_score 67.3741
## direct_score direct_score 21.9524
## scrnCnt scrnCnt 8.3274
## genre genre 1.0995
## showTm showTm 1.0116
## season_score season_score 0.1323
## company_score company_score 0.0674
## nations nations 0.0221
## watchGrade watchGrade 0.0132
## week_score week_score 0.0000
# 변수의 중요도가 배우 > 감독 > 스크린수 > 배급사 순으로 나타남
## GBM_RMSE GBM_MAPE
## 1 577120 1.71
# 시험셋으로 목표변수의 추정값을 확인해보고 RMSE, MAPE를 구해봄. MAPE가 1.706으로 GBM 회귀모형이 실제값을 예측할 수 있음
## nations scrnCnt audiCnt watchGrade showTm genre company_score
## 1 한국 1948 NA 15세이상관람가 131 드라마 2014121
## 2 한국 1128 NA 15세이상관람가 125 SF 2014121
## 3 한국 976 NA 15세이상관람가 125 액션 2014121
## 4 한국 1183 NA 15세이상관람가 105 액션 1793032
## season_score week_score actor_score direct_score
## 1 258989 181709 1474136 6440557
## 2 402692 181709 1616655 6440557
## 3 355186 867177 755997 2883691
## 4 402692 867177 201696 773293
## [1] "SF" "공포(호러)" "드라마" "뮤지컬" "미스터리"
## [6] "범죄" "사극" "스릴러" "애니메이션" "액션"
## [11] "어드벤처" "전쟁" "코미디" "판타지"
## [1] "한국" "한국" "한국" "한국"
## [1] "미국" "제3국" "한국"
## [1] "12세이상관람가" "12세이상관람가,15세이상관람가"
## [3] "12세이상관람가,전체관람가" "15세관람가"
## [5] "15세관람가,12세이상관람가" "15세이상관람가"
## [7] "15세이상관람가,전체관람가" "전체관람가"
## [9] "청소년관람불가" "청소년관람불가,15세이상관람가"
## [1] "SF" "공포(호러)" "드라마" "뮤지컬" "미스터리"
## [6] "범죄" "사극" "스릴러" "애니메이션" "액션"
## [11] "어드벤처" "전쟁" "코미디" "판타지"
## movieCd movieNm Real_audiCnt pred_RF pred_GBM diff_RF diff_GBM
## 1 20183782 기생충 10085275 9149226 9279702 936049 805573
## 2 20126674 설국열차 8914845 8484259 9359709 430586 -444864
## 3 20151228 공조 7817446 5502090 3876518 2315356 3940928
## 4 20156554 물괴 723414 834992 974815 -111578 -251401
# 4개영화를 임의로 선정해서 각 모델을 통해 관객수를 예측해봄.
# 공조의 경우 예측값과 실제값의 차이가 큰데, 이는 같은날에 개봉한 대작인 더킹의 영향이 큼. 이는 천만가량의 관객파이를 두 영화가 나눠가지면서 나타난 결과라고 봄.
천만배우라는 말이 괜히 나온게 아닌것처럼 관객동원에 있어서 주연배우의 영향도가 크다는 것을 알 수 있었음.
다만, 영화 내적인 요소 외에 다른 변수들(네이버 네티즌 영화 평점, 댓글 갯수, 개봉당시 경쟁작 존재여부 등)을 고려해보지 못한 점은 아쉬움으로 남음.
apikey <- 'dcb81e6219b6a0ac87e910ff8bd0633c' #윤희1
apikey <- '839d48649cc43a32c5f9d01aec3f56da' #윤희2
apikey <- 'd7f02bb7237005c899c18505ddca7686' #병현1
apikey <- '93ccb7d8bf1e51c51c971a94df598ee0' #병현2
apikey <- 'bfbc2f2b7f61114c0419e52a835c18ed' #병현3
apikey <- '55187da05e5ca80981f646c7b8edbf65' #병현4
# 1. 2010~2019 개봉영화 리스트 수집----
# 일일 api 요청횟수 3000건 제한으로 연도별 분할하여 수집
mlist <- NULL
for(i in 1:123){
cat(i, '번째 페이지 수집중.\n')
res <- GET(url = 'http://www.kobis.or.kr/kobisopenapi/webservice/rest/movie/searchMovieList.json',
query = list('key' = apikey,
'curPage' = i,
'itemPerPage' = 100,
'openStartDt' = 2010,
'openEndDt' = 2019))
tmp <- res %>% content(as = 'text') %>% fromJSON()
mlist <- rbind(mlist, tmp$movieListResult$movieList)
}
mcd <- mlist$movieCd
# 2. 해당하는 영화 상세정보 수집----
mvdata <- NULL
for(i in 1:length(mcd)){
res <- GET(url = 'http://www.kobis.or.kr/kobisopenapi/webservice/rest/movie/searchMovieInfo.json',
query = list('key' = apikey,
'movieCd' = mcd[i]))
tmp <- res %>% content(as = 'text') %>% fromJSON()
# 필요한 컬럼만 골라내서 mvdata에 적재
cat(i,"번째 수집완료!\n")
movie_Cd <- tmp$movieInfoResult$movieInfo$movieCd
showTm <- tmp$movieInfoResult$movieInfo$showTm
actor <- tryCatch(tmp$movieInfoResult$movieInfo$actors$peopleNm[c(1,2,3)], error=function(e){})
gen <- tmp$movieInfoResult$movieInfo$genres$genreNm
direct <- tmp$movieInfoResult$movieInfo$directors$peopleNm
company <- tryCatch(tmp$movieInfoResult$movieInfo$companys
[which(tmp$movieInfoResult$movieInfo$companys$companyPartNm == '배급사'),]$companyNm,
error=function(e){})
mvset <- cbind(list(movie_Cd), list(showTm), list(actor), list(gen), list(direct), list(company))
mvdata <- rbind(mvdata, mvset)
}
# 데이터프레임으로 변경
mvdata <- as.data.frame(mvdata)
colnames(mvdata1214) <- c("movie_Cd", "showTm", "actor", "gen" ,"direct" ,"company")
# 연도별 데이터를 하나로 합침
mvdata_all <- rbind.data.frame(mvdata1214, mvdata2015, mvdata2016, mvdata2017, mvdata2018, mvdata2019)
# 배우명/장르/감독/회사 없는 컬럼 제거
mvdata_all %>%
dplyr::filter((actor != "NULL")
& (gen != "NULL")
& (direct != "NULL")
& (company != "NULL")) -> mvdata_all
# 리스트 형태로 묶인 장르/배우/감독정보 구분 및 변수생성
for(i in 1: nrow(x = mvdata_all2)){
mvdata_all2$genre[i] <- mvdata_all2$gen[[i]][1]
mvdata_all2$actor1[i] <- mvdata_all2$actor[[i]][1]
mvdata_all2$actor2[i] <- mvdata_all2$actor[[i]][2]
mvdata_all2$actor3[i] <- mvdata_all2$actor[[i]][3]
mvdata_all2$direct1[i] <- mvdata_all2$direct[[i]][1]
mvdata_all2$company1[i] <- mvdata_all2$company[[i]][1]
}
# 컬럼 구조 확인
str(mvdata_all2)
# 형변환
mvdata_all2[1:2] <- map_df(.x = mvdata_all2[1:2],
.f = as.character)
# 불필요 컬럼 제거
mvdata_all %>%
dplyr::select(c(1,2,7:12)) -> mvdata_all
# 변수명 재설정
colnames(mvdata_all) <- c("movieCd", "showTm", "genre", "actor1", "actor2", "actor3", "direct" ,"company")
# 3. 영화별 실적 불러와서 영화정보 합치기----
KOBIS <- read_xlsx(path = 'KOBIS.xlsx')
# movieCd기준으로 innerjoin
rawdata <- inner_join(x = KOBIS,
y = mvinfo,
by = 'movieCd')
# 4. 각 변수별 평균매출, 평균관중수 산출 ----
ed <- readRDS(file = 'EDA.RDS')
ed[, 15:27] <- NULL
# 관객수 10000명 이상인 영화만 기준으로 필터링
ed1 <- ed %>%
dplyr::filter(audiCnt >= 10000)
# actor1 ----
ed1$actor1_mean <- NA
for(i in 1:nrow(ed1)){
print(paste("i = ", i))
df <- data.frame()
for(j in 1:nrow(ed1)){
# print(paste('>>j = ', j))
if(ed1$openDt[i] > ed1$openDt[j]){
df <- rbind(df, ed1[j, ])
}
}
print(paste('>>j = ', j))
if(dim(df)[1] != 0){
df %>%
group_by(actor1) %>%
mutate(actor1_mean = mean(audiCnt)) -> df
for(k in 1:nrow(df)){
# print(paste('>>>> k = ', k))
if(ed1$actor1[i] == df$actor1[k]){
ed1$actor1_mean[i] = df$actor1_mean[k]
}
}
print(paste('>>>> k = ', k))
}
if(is.na(ed1$actor1_mean[i])){
print(paste('NO SAME NAME : ', i))
ed1$actor1_mean[i] = ed1$audiCnt[i]
}
}
# actor2 ---
ed2 <- ed1
ed2$actor2_mean <- NA
for(i in 1:nrow(ed2)){
if(is.na(ed2$actor2[i])){
ed2$actor2_mean = 0
}
else{
print(paste("i = ", i))
df <- data.frame()
for(j in 1:nrow(ed2)){
# print(paste('>>j = ', j))
if(ed2$openDt[i] > ed2$openDt[j]){
df <- rbind(df, ed2[j, ])
}
}
print(paste('>>j = ', j))
if(dim(df)[1] != 0){
df %>%
group_by(actor2) %>%
mutate(actor2_mean = mean(audiCnt)) -> df
for(k in 1:nrow(df)){
print(paste('>>>> k = ', k))
if(!is.na(df$actor2[k])){
if(ed2$actor2[i] == df$actor2[k]){
ed2$actor2_mean[i] = df$actor2_mean[k]
}
}
}
print(paste('>>>> k = ', k))
}
if(is.na(ed2$actor2_mean[i])){
print(paste('NO SAME NAME : ', i))
ed2$actor2_mean[i] = ed2$audiCnt[i]
}
}
}
# actor3 ---
ed3 <- ed2
ed3$actor3_mean <- NA
for(i in 1:nrow(ed3)){
if(is.na(ed3$actor3[i])){
ed3$actor3_mean = 0
}
else{
print(paste("i = ", i))
df <- data.frame()
for(j in 1:nrow(ed3)){
# print(paste('>>j = ', j))
if(ed3$openDt[i] > ed3$openDt[j]){
df <- rbind(df, ed3[j, ])
}
}
print(paste('>>j = ', j))
if(dim(df)[1] != 0){
df %>%
group_by(actor3) %>%
mutate(actor3_mean = mean(audiCnt)) -> df
for(k in 1:nrow(df)){
print(paste('>>>> k = ', k))
if(!is.na(df$actor3[k])){
if(ed3$actor3[i] == df$actor3[k]){
ed3$actor3_mean[i] = df$actor3_mean[k]
}
}
}
print(paste('>>>> k = ', k))
}
if(is.na(ed3$actor3_mean[i])){
print(paste('NO SAME NAME : ', i))
ed3$actor3_mean[i] = ed3$audiCnt[i]
}
}
}
# direct ----
ed4 <- ed3
ed4$direct_mean <- NA
for(i in 1:nrow(ed4)){
if(is.na(ed4$direct[i])){
ed4$direct_mean = 0
}
else{
print(paste("i = ", i))
df <- data.frame()
for(j in 1:nrow(ed4)){
# print(paste('>>j = ', j))
if(ed4$openDt[i] > ed4$openDt[j]){
df <- rbind(df, ed4[j, ])
}
}
print(paste('>>j = ', j))
if(dim(df)[1] != 0){
df %>%
group_by(direct) %>%
mutate(direct_mean = mean(audiCnt)) -> df
for(k in 1:nrow(df)){
print(paste('>>>> k = ', k))
if(!is.na(df$direct[k])){
if(ed4$direct[i] == df$direct[k]){
ed4$direct_mean[i] = df$direct_mean[k]
}
}
}
print(paste('>>>> k = ', k))
}
if(is.na(ed4$direct_mean[i])){
print(paste('NO SAME NAME : ', i))
ed4$direct_mean[i] = ed4$audiCnt[i]
}
}
}
write_xlsx(x = ed1,
path = 'ed1.xlsx')
# 최종 rawdata 저장
rawdata_fin <- read_xlsx(path = 'fin.xlsx')
rawdata_finas.data.frame(rawdata_fin)
saveRDS(object = rawdata_fin,
file = 'rawdata_fin.RDS')
# 파생변수 생성 및 전처리 ----
total_data <- readRDS(file = 'rawdata_fin.RDS')
total_data <- as.data.frame(total_data)
# 장르별 평균 관객동원이 10000이하인 장르 데이터 제거
total_data %>% group_by(genre) %>% mutate(genre_cnt = mean(audiCnt)) %>%
select(genre, genre_cnt) %>%
arrange(desc(genre_cnt)) %>% unique() %>%
dplyr::filter(genre_cnt >= 100000) -> list
total_data <- total_data %>%
dplyr::filter(genre %in% list$genre)
# 미국/한국/제3국 분류
total_data$nations[total_data$nations != '미국' &
total_data$nations != '한국'] = '제3국'
# 월, 요일 파생변수 생성
as.character(total_data$openDt, '%m') -> total_data$month
as.character(total_data$openDt, '%a') -> total_data$week
total_data <- total_data %>%
mutate(season = ifelse(month %in% c('03','04','05'),
yes = '봄',
ifelse(month %in% c('06','07','08'),
yes = '여름',
ifelse(month %in% c('09','10','11'),
yes = '가을',
no = '겨울'))))
# 배급사, 계절, 요일 스코어 파생변수 생성
total_data <- total_data %>% group_by(company) %>% mutate(company_score = mean(audiCnt))
total_data <- total_data %>% group_by(season) %>% mutate(season_score = mean(audiCnt))
total_data <- total_data %>% group_by(week) %>% mutate(week_score = mean(audiCnt))
# 주연배우 1,2,3 가중평균 스코어 산출(배우스코어)
total_data <- total_data %>%
mutate(actor_score = (actor1_mean * 0.5 + actor2_mean * 0.3 + actor3_mean * 0.2) / 3,
direct_score = direct_mean * 1)
# 문자형변수 팩터로 변환
total_data$nations <- as.factor(total_data$nations)
total_data$genre <- as.factor(total_data$genre)
total_data$watchGrade <- as.factor(total_data$watchGrade)
total_data$showTm <- as.integer(total_data$showTm)
total_data$season <- as.factor(total_data$season)
total_data$week <- as.factor(total_data$week)
total_data <- as.data.frame(x = total_data)
saveRDS(object = total_data,
file = 'total.RDS')
# total_data <- readRDS(file = 'total.RDS')
# 머신러닝 모델링에 불필요한 변수들 제거(총 11개만 남겨둠)
total_data <- total_data %>%
select(-c(movieCd, movieNm, openDt, sales, actor1, actor2, actor3, direct, company,
actor1_mean, actor2_mean, actor3_mean, direct_mean, month, week, season))
saveRDS(object = total_data,
file = 'total.RDS')
# 여기서부터 읽음(12/19 16:50)
total_data <- readRDS(file = 'total.RDS')
options(scipen = 100)
# 훈련셋 테스트셋 8:2 비중으로 분류
set.seed(seed = 1234)
index <- sample(x = nrow(total_data),
size = nrow(total_data) * 0.8,
replace = FALSE)
trainSet <- total_data[index, ]
testSet <- total_data[-index, ]
# 예측모형도 미리 만들어줌
predi <- read_xlsx(path = 'pred.xlsx')
as.data.frame(predi)
predi$audiCnt <- 10
# 각 변수별로 레벨을 설정해줌.
levels(trainSet$genre)
predi$nations <- factor(predi$nations, levels=c("미국","제3국","한국"))
predi$watchGrade <- factor(predi$watchGrade, levels=c("12세이상관람가",
"12세이상관람가,15세이상관람가",
"12세이상관람가,전체관람가",
"15세관람가",
"15세관람가,12세이상관람가",
"15세이상관람가",
"15세이상관람가,전체관람가",
"전체관람가",
"청소년관람불가",
"청소년관람불가,15세이상관람가"))
predi$genre <- factor(predi$genre, levels=c("SF",
"공포(호러)",
"드라마",
"뮤지컬",
"미스터리",
"범죄",
"사극",
"스릴러",
"애니메이션",
"액션",
"어드벤처",
"전쟁",
"코미디",
"판타지"))
levels(predi$nations)
levels(predi$watchGrade)
levels(predi$genre)
# 레벨설정 후 팩터화
predi$nations <- as.factor(predi$nations)
predi$genre <- as.factor(predi$genre)
predi$watchGrade <- as.factor(predi$watchGrade)
predi$showTm <- as.integer(predi$showTm)
# 모델링
library(randomForest)
library(generics)
real <- testSet$audiCnt
grid <- expand.grid(depth = c(1, 3, 5),
learn = c(0.01, 0.05, 0.10),
min = c(5, 7, 10),
bag = c(0.5, 0.8, 1.0),
rmse = NA,
tree = NA)
for(i in 1:nrow(x = grid)){
set.seed(seed = 1234)
fit <- gbm(formula = audiCnt ~ .,
data = trainSet,
distribution = 'gaussian',
n.trees = 5000,
interaction.depth = grid$depth[i],
shrinkage = grid$learn[i],
n.minobsinnode = grid$min[i],
bag.fraction = grid$bag[i],
train.fraction = 0.75)
grid$rmse[i] <- fit$valid.error %>% min %>% sqrt()
grid$tree[i] <- which.min(x = fit$valid.error)
}
loc <- which.min(x = grid$rmse); print(x = loc)
betsPara <- grid[loc,]
set.seed(seed = 1234)
fit1 <- gbm(formula = audiCnt ~ .,
data = trainSet,
distribution = 'gaussian',
n.trees = betsPara$tree,
interaction.depth = betsPara$depth,
shrinkage = betsPara$learn,
n.minobsinnode = betsPara$min,
bag.fraction = betsPara$bag,
train.fraction = 0.75)
print(x = fit1)
par(mar = c(5,11,4,2))
summary(object = fit1, las = 2)
pred1 <- predict(object = fit1,
newdata = testSet,
n.trees = betsPara$tree)
preddd <- predict(object = fit1,
newdata = predi,
n.trees = betsPara$tree)
view(preddd)
error1 <- real - pred1
rmse1 <- error1^2 %>% mean() %>% sqrt()
mape1 <- (abs(x = error1) / abs(x = real)) %>% mean()
trainSet2 <- na.omit(object = trainSet)
# 랜덤포레스트
grid <- expand.grid(ntree = c(300, 500, 700, 1000),
mtry = c(3,4,5,6,7),
mse = NA)
for(i in 1:nrow(x = grid)){
set.seed(seed = 1234)
fit <- randomForest(x = trainSet2[, -3],
y = trainSet2[, 3],
ntree = grid[i, 'ntree'],
mtry = grid[i, 'mtry'])
grid$mse[i] <- tail(x = fit$mse, n = 1)
}
loc <- which.min(x = grid$mse); print(x = loc)
bestPa <- grid[loc,]
set.seed(seed = 1234)
fit2 <- randomForest(x = trainSet[, -3],
y = trainSet[, 3],
ntree = bestPa$ntree,
mtry = bestPa$mtry)
importance(x = fit2)
varImpPlot(x = fit2)
print(x = fit2)
plot(x = fit2)
summary(fit2)
pred2 <- predict(object = fit2,
newdata = testSet,
type = 'response')
predd <- predict(object = fit2,
newdata = predi,
type = 'response')
view(predd)
view(predi)
error2 <- real - pred2
rmse2 <- error2^2 %>% mean() %>% sqrt()
mape2 <- (abs(x = error2) / abs(x = real)) %>% mean()
# 네트워크맵 그려보기
mv <- read_xlsx('bh2.xlsx')
mv <- as_tbl_graph(mv)
par(family = 'AppleGothic')
mv %>%
as_tbl_graph() %>%
ggraph(layout='kk') +
geom_node_text(aes(label=name),
family = 'AppleGothic') +
geom_edge_link(aes(start_cap = label_rect(node1.name), end_cap = label_rect(node2.name)))